perm filename MOD1.F4[JC,MUS] blob sn#007306 filedate 1972-07-16 generic text, type T, neo UTF8
00100		DIMENSION  W1(512),FUNC(512),SU(1000)
00200		DO 1 I=1,1000
00300	1	SU(I)=0.0
00400		GO TO 43
00500	40	CALL HYDPOG(1)
00510		TYPE 31,A,FC,FM,XI
00515	31	FORMAT(4F/)
00600	43	TYPE 41
00700	41	FORMAT(' TYPE 1 FOR WITHOUT SIN ELSE 2'/)
00800		ACCEPT 42,JP
00900	42	FORMAT(I)
01000	60	TYPE 50
01100	50	FORMAT(' TYPE A,CF,MF,I'/)
01200		ACCEPT 100,A,FC,FM,XI
01300	100	FORMAT (4F)
01400		CALL TYPLOC(-300,-512)
01500		CALL DPYSET(1,SU,1000)
01600		CALL DPYBRT(1)
01700		CALL AIVECT(0,0)
01800		CALL ALINE(0,-12,0,12)
01900		CALL ALINE(256,-12,256,12)
02000		CALL ALINE(-268,128,-244,128)
02100		CALL ALINE(-268,256,-244,256)
02200		CALL ALINE(-268,-128,-244,-128)
02300		CALL ALINE(-268,-254,-244,-254)
02400		CALL ALINE(-264,0,256,0)
02500		CALL ALINE(-256,-256,-256,256)
02600		CALL DPYBRT(6)
02700		I=-1
02800		DO 200 J=1,513
02900		X=J-1
03000		Y=6.28319/512.
03100		IF(JP.EQ.1)GO TO 1000
03200		FUNC(J)=A*SIN((FC*X)*Y-(XI*(COS((FM*X)*Y)))+XI)
03300		IY2=FUNC(J)*256.
03400		GO TO 1002
03500	1000	FUNC(J)=(FC*X)*Y-XI*(COS((FM*X)*Y))+XI
03600		IY2=FUNC(J)*256./6.28319
03700	1002	IF(I.EQ.0)GO TO 150
03800		CALL AIVECT(-256,IY2)
03900		I=0
04000		GO TO 160
04100	150	CALL SVECT(1,IY2-IY)
04200	160	IY=IY2
04300	200	CONTINUE
04400		CALL DPYOUT(1)
04500		TYPE 401
04600	401	FORMAT(' 0 TO CHANGE ELSE N'/)
04700		ACCEPT 300,M
04800	300	FORMAT (I)
04900		IF(M.EQ.0)GO TO 40
05000		TYPE 501
05100	501	FORMAT(' 3 CHAR. FOR .DAT FILE'/)
05200		ACCEPT 502,V
05300	502	FORMAT(A3)
05400		CALL OFILE(1,V)
05500		WRITE(1)(SU(K),K=1,1000)
05600		END FILE 1
05700		GO TO 40
05800		END